home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / KFACTOR.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-01-28  |  8.2 KB  |  258 lines
  1. 10  'KFACTOR - for Antennas - 06 MAY 96 rev.27 SEP 96
  2. 20  'edited-for-HAMCALC version of KNEC.BAS, by L.B.Cebik, W4RNL
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  IF PROG$=""THEN GO$=EX$ ELSE GO$=PROG$
  5. 50  COMMON EX$,PROG$
  6. 60  CLS:KEY OFF
  7. 70  COLOR 7,0,1
  8. 80  I$=CHR$(34)+" ="
  9. 90  UL$=STRING$(80,205)
  10. 100  U1$="#####.##"
  11. 110  U2$="####.####"
  12. 120  X$=STRING$(79,32)
  13. 130  '
  14. 140  '.....title
  15. 150  CLS:F=0
  16. 160  COLOR 15,2
  17. 170  PRINT " K-FACTOR & ANTENNA LENGTH (NEC-2)";TAB(62);"by L.B.Cebik W4RNL ";
  18. 180  PRINT STRING$(80,32);
  19. 190  LOCATE CSRLIN-1,20:PRINT "Edited for HAMCALC by George Murphy VE3ERP";
  20. 200  COLOR 1,0:PRINT STRING$(80,223);:COLOR 7,0
  21. 210  '
  22. 220  '.....antenna disclaimer
  23. 230  OPEN"I",1,"\data\docfiles\antenna.doc"
  24. 240  IF EOF(1)THEN 260
  25. 250  INPUT#1,NOTE$:PRINT "   ";NOTE$:GOTO 240
  26. 260  CLOSE
  27. 270  PRINT UL$;
  28. 280  '
  29. 290  GOSUB 2230    'preface
  30. 300  COLOR 0,7:LOCATE 25,22
  31. 310  PRINT " Press 1 to continue or 0 to EXIT.....";
  32. 320  COLOR 7,0
  33. 330  Z$=INKEY$:IF Z$=""THEN 330
  34. 340  IF Z$="0"THEN CLS:CHAIN GO$
  35. 350  IF Z$="1"THEN CLS:GOTO 370
  36. 360  GOTO 330
  37. 370  CLS
  38. 380  PRINT " Press number in < > to choose standard units of measure:"
  39. 390  PRINT UL$;
  40. 400  PRINT "  < 1 >  Metric"
  41. 410  PRINT "  < 2 >  U.S.A./Imperial
  42. 420  PRINT UL$;
  43. 430  Z$=INKEY$:IF Z$=""THEN 430
  44. 440  IF Z$="1"THEN UM=1:GOTO 470
  45. 450  IF Z$="2"THEN UM=2:GOTO 470
  46. 460  GOTO 430
  47. 470  CLS
  48. 480  PRINT " Press number in < > for:"
  49. 490  PRINT UL$;
  50. 500  PRINT "  < 3 >  Horizontal antenna lengths from 1 to 7 half-wavelengths"
  51. 510  PRINT
  52. 520  PRINT "  < 4 >  Vertical antenna lengths from 1 to 7 quarter-wavelengths"
  53. 530  IF VK=1 THEN 570
  54. 540  PRINT
  55. 550  PRINT "  < 5 >  Table of values of K, with lengths of DEFSTR-wavelength vertical"
  56. 560  PRINT "         and RENUM-wavelength horizontal antennas"
  57. 570  Z$=INKEY$:IF Z$=""THEN 570
  58. 580  IF Z$="3"THEN HV=1:GOTO 630
  59. 590  IF Z$="4"THEN HV=0.5:GOTO 630
  60. 600  IF Z$="5"THEN VK=1:GOTO 1420
  61. 610  GOTO 570
  62. 620  '
  63. 630  '.....Option A calculations
  64. 640  CLS
  65. 650  COLOR 15,2:PRINT STRING$(80,32);
  66. 660  LOCATE 1,8
  67. 670  IF HV=0.5 THEN 700
  68. 680  PRINT "Table of Horizontal Antenna Lengths from 1 to 7 Half-Wavelengths"
  69. 690  IF HV=1 THEN 710
  70. 700  PRINT "Table of Vertical Antenna Lengths from 1 to 7 Quarter-Wavelengths"
  71. 710  COLOR 7,0
  72. 720  PRINT
  73. 730  PRINT " AWG Wire sizes are copper. Other conductor sizes are aluminum.";
  74. 740  IF HV=0.5 THEN PRINT " Vertical antennas assumed to be over perfect ground."
  75. 750  PRINT UL$;
  76. 760  IF F*WLF THEN 820
  77. 770  COLOR 0,7:INPUT " ENTER: Frequency of interest in MHz......",F
  78. 780  COLOR 7,0
  79. 790  IF F<3 OR F>30 THEN LOCATE CSRLIN-1:PRINT X$:LOCATE CSRLIN-1:GOTO 770
  80. 800  WLF=983.571/F       'speed of light = 983.5712 feet per second
  81. 810  LOCATE CSRLIN-1:PRINT X$:LOCATE CSRLIN-1
  82. 820  PRINT" Frequency =";F;"MHz";
  83. 830  IF UM=1 THEN M=0.3048:F$="metres"
  84. 840  IF UM=2 THEN M=1:F$="feet"
  85. 850  IF HV=1 THEN W$="RENUM"
  86. 860  IF HV=0.5 THEN W$="DEFSTR"
  87. 870  M$=" Lengths in "+F$+" for N no. of "+W$+"-wavelengths "
  88. 880  PRINT TAB(25)"Wavelength in Free Space =";:PRINT USING "####.##";WLF*M;
  89. 890  PRINT" ";F$
  90. 900  PRINT UL$;
  91. 910  PRINT " VARPTRSOUNDSOUNDSOUNDSOUND Wire Size SOUNDSOUNDSOUNDSOUNDCOLOR";
  92. 920  PRINT TAB(25)"VARPTRSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUND";SPC(39);"SOUNDSOUNDSOUNDSOUNDSOUNDSOUNDSOUNDCOLOR"
  93. 930  LOCATE CSRLIN-1,(52-LEN(M$)/2):PRINT M$
  94. 940  PRINT " AWG";
  95. 950  PRINT TAB(27);"N=1     N=2     N=3     N=4     N=5     N=6     N=7"
  96. 960  PRINT UL$;
  97. 970  FOR A=1 TO 14
  98. 980  ON A GOTO 1000,1010,1020,1030,1040,1050,1060,1070,1080,1090,1100,1110,1120,1130
  99. 990  '
  100. 1000  W$=" #18-0.0403":LQL=959.435:LQH=95.335:LTL=6848.87:LTH=684.82:GOTO 1150
  101. 1010  W$=" #16-0.0508":LQL=959.183:LQH=95.252:LTL=6850.53:LTH=684.8:GOTO 1150
  102. 1020  W$=" #14-0.0641":LQL=958.885:LQH=95.154:LTL=6851.67:LTH=684.768:GOTO 1150
  103. 1030  W$=" #12-0.0808":LQL=958.478:LQH=95.048:LTL=6852.43:LTH=684.699:GOTO 1150
  104. 1040  W$=" #10-0.1019":LQL=958.001:LQH=94.931:LTL=6852.81:LTH=684.618:GOTO 1150
  105. 1050  W$=" 0.125"     :LQL=957.22:LQH=94.807:LTL=6850.95:LTH=684.45:GOTO 1150
  106. 1060  W$=" 0.250"     :LQL=955.36:LQH=94.35:LTL=6851.31:LTH=684.082:GOTO 1150
  107. 1070  W$=" 0.500"     :LQL=952.85:LQH=93.734:LTL=6850.05:LTH=683.55:GOTO 1150
  108. 1080  W$=" 0.750"     :LQL=951.03:LQH=93.275:LTL=6848.59:LTH=683.144:GOTO 1150
  109. 1090  W$=" 1.000"     :LQL=949.58:LQH=92.898:LTL=6847.46:LTH=682.82:GOTO 1150
  110. 1100  W$=" 1.250"     :LQL=948.31:LQH=92.575:LTL=6846.2:LTH=682.555:GOTO 1150
  111. 1110  W$=" 1.500"     :LQL=947.22:LQH=92.292:LTL=6845.25:LTH=682.332:GOTO 1150
  112. 1120  W$=" 1.750"     :LQL=946.22:LQH=92.038:LTL=6844.28:LTH=682.14:GOTO 1150
  113. 1130  W$=" 2.000"     :LQL=945.3:LQH=91.812:LTL=6843.45:LTH=681.983:GOTO 1150
  114. 1140  '
  115. 1150  Q=2950.71:LQW=Q/F:LQWH=Q/30:LQWL=Q/3:KQH=LQH/LQWH:KQL=LQL/LQWL
  116. 1160  KTH=LTH/(3*LQWH):KTL=LTL/(3*LQWL)
  117. 1170  EE=(((F/3)-1)*0.0333333)+0.61:KQW=KQH+((0.4343*LOG(30/F))^EE)*(KQL-KQH)
  118. 1180  KTQ=KTH+((0.4343*LOG(30/F))^EE)*(KTL-KTH)
  119. 1190  LQ=KQW*LQW:LT=KTQ*(3*LQW):KE=(6*LQ)/(LT-LQ):KM=KQW/KE
  120. 1200  IF A<=5 THEN MM=VAL(RIGHT$(W$,5))ELSE MM=VAL(W$)
  121. 1210  MM=MM*25.4
  122. 1220  IF A>5 THEN PRINT SPC(6);
  123. 1230  PRINT W$;I$;
  124. 1240  LOCATE CSRLIN,15:PRINT USING "##.#";MM;:PRINT "mm";
  125. 1250  LOCATE CSRLIN,23
  126. 1260  FOR B=1 TO 7
  127. 1270  BB=B-1:LD=(2*LQW)/12:LL=((BB*LD)*KM)+(KQW*LD)
  128. 1280  PRINT USING U1$;LL*M*HV;
  129. 1290  NEXT B
  130. 1300  NEXT A
  131. 1310  '
  132. 1320  GOSUB 2450     'screen dump
  133. 1330  LOCATE 25,1:PRINT X$;:LOCATE 25,8:COLOR 15,2
  134. 1340  PRINT " Do you want (a)nother run, (v)alues of K, or (q)uit?    (a/v/q) ";
  135. 1350  COLOR 7,0
  136. 1360  Z$=INKEY$:IF Z$=""THEN 1360
  137. 1370  IF Z$="a"THEN F=0:GOTO 630
  138. 1380  IF Z$="v"THEN VK=1:GOTO 1420
  139. 1390  IF Z$="q"THEN 140
  140. 1400  GOTO 1360
  141. 1410  '
  142. 1420  '.....Option B calculations
  143. 1430  CLS
  144. 1440  COLOR 15,2:PRINT STRING$(80,32);
  145. 1450  LOCATE 1,16:PRINT "Calculation of K, the Antenna Shortening Factor"
  146. 1460  COLOR 7,0
  147. 1470  LOCATE 3,1
  148. 1480  PRINT" KT is the total shortening factor. KM is the shortening factor";
  149. 1490  PRINT" due to element"
  150. 1500  PRINT" material. KE is the shortening factor due to end effect. Values";
  151. 1510  PRINT" calibrated to"
  152. 1520  PRINT" NEC-2 models for 3-30 MHz.  AWG sizes are copper. Other sizes";
  153. 1530  PRINT" are aluminum."
  154. 1540  PRINT UL$;
  155. 1550  IF F*WLF THEN 1620
  156. 1560  COLOR 0,7
  157. 1570  INPUT " ENTER: Frequency of interest in MHz......",F
  158. 1580  COLOR 7,0
  159. 1590  IF F<3 OR F>30 THEN LOCATE CSRLIN-1:PRINT X$:LOCATE CSRLIN-1:GOTO 1560
  160. 1600  WLF=983.571/F
  161. 1610  LOCATE CSRLIN-1:PRINT X$
  162. 1620  IF UM=1 THEN M$=" metres":Z=0.3048
  163. 1630  IF UM=2 THEN M$=" feet":Z=1
  164. 1640  LOCATE 7,1:PRINT" Frequency =";F;"MHz.    Wavelength in Free Space =";
  165. 1650  PRINT USING "####.##";WLF*Z;:PRINT M$
  166. 1660  IF UM=1 THEN M$="Lgth (m.)"
  167. 1670  IF UM=2 THEN M$="Lgth (ft)"
  168. 1680  LOCATE 8:PRINT "VARPTRSOUNDSOUNDSOUNDSOUND Wire Size SOUNDSOUNDSOUNDSOUNDCOLOR"
  169. 1690  LOCATE 8,49:PRINT " DEFSTR-wave Vertical  RENUM-wave Dipole ";
  170. 1700  LOCATE 9:PRINT " AWG"
  171. 1710  LOCATE 9,26:PRINT"KT       KM       KE"
  172. 1720  LOCATE 9,53:PRINT M$;SPC(7);M$
  173. 1730  LOCATE 10:PRINT UL$;
  174. 1740  FOR A=1 TO 14
  175. 1750  ON A GOTO 1770,1780,1790,1800,1810,1820,1830,1840,1850,1860,1870,1880,1890,     1900
  176. 1760  '
  177. 1770  W$=" #18-0.0403":LQL=959.435:LQH=95.335:LTL=6848.87:LTH=684.82:GOTO 1910
  178. 1780  W$=" #16-0.0508":LQL=959.183:LQH=95.252:LTL=6850.53:LTH=684.8:GOTO 1910
  179. 1790  W$=" #14-0.0641":LQL=958.885:LQH=95.154:LTL=6851.67:LTH=684.768:GOTO 1910
  180. 1800  W$=" #12-0.0808":LQL=958.478:LQH=95.048:LTL=6852.43:LTH=684.699:GOTO 1910
  181. 1810  W$=" #10-0.1019":LQL=958.001:LQH=94.931:LTL=6852.81:LTH=684.618:GOTO 1910
  182. 1820  W$=" 0.125"     :LQL=957.22:LQH=94.807:LTL=6850.95:LTH=684.45:GOTO 1910
  183. 1830  W$=" 0.250"     :LQL=955.36:LQH=94.35:LTL=6851.31:LTH=684.082:GOTO 1910
  184. 1840  W$=" 0.500"     :LQL=952.85:LQH=93.734:LTL=6850.05:LTH=683.55:GOTO 1910
  185. 1850  W$=" 0.750"     :LQL=951.03:LQH=93.275:LTL=6848.59:LTH=683.144:GOTO 1910
  186. 1860  W$=" 1.000"     :LQL=949.58:LQH=92.898:LTL=6847.46:LTH=682.82:GOTO 1910
  187. 1870  W$=" 1.250"     :LQL=948.31:LQH=92.575:LTL=6846.2:LTH=682.555:GOTO 1910
  188. 1880  W$=" 1.500"     :LQL=947.22:LQH=92.292:LTL=6845.25:LTH=682.332:GOTO 1910
  189. 1890  W$=" 1.750"     :LQL=946.22:LQH=92.038:LTL=6844.28:LTH=682.14:GOTO 1910
  190. 1900  W$=" 2.000"     :LQL=945.3:LQH=91.812:LTL=6843.45:LTH=681.983:GOTO 1910
  191. 1910  Q=2950.71:LQW=Q/F:LQWH=Q/30:LQWL=Q/3:KQH=LQH/LQWH:KQL=LQL/LQWL
  192. 1920  KTH=LTH/(3*LQWH):KTL=LTL/(3*LQWL)
  193. 1930  EE=(((F/3)-1)*0.0333333)+0.61:KQW=KQH+((0.4343*LOG(30/F))^EE)*(KQL-KQH)
  194. 1940  KTQ=KTH+((0.4343*LOG(30/F))^EE)*(KTL-KTH)
  195. 1950  LQ=KQW*LQW:LT=KTQ*(3*LQW):KE=(6*LQ)/(LT-LQ):KM=KQW/KE
  196. 1960  IF KM>0.9999 THEN KM=0.9999
  197. 1970  V=KQW*(245.893/F):D=V*2
  198. 1980  IF A<=5 THEN MM=VAL(RIGHT$(W$,5))ELSE MM=VAL(W$)
  199. 1990  MM=MM*25.4
  200. 2000  IF A>5 THEN PRINT SPC(4);
  201. 2010  PRINT W$;I$;
  202. 2020  LOCATE CSRLIN,15:PRINT USING "##.#";MM;:PRINT "mm";
  203. 2030  LOCATE CSRLIN,21
  204. 2040  PRINT USING U2$;KQW;KM;KE;
  205. 2050  IF UM=1 THEN Z=0.3048
  206. 2060  IF UM=2 THEN Z=1
  207. 2070  PRINT SPC(4);USING U1$;V*Z;
  208. 2080  PRINT SPC(8);USING U1$;D*Z;
  209. 2090  IF A<14 THEN PRINT ""
  210. 2100  NEXT A
  211. 2110  GOSUB 2450     'screen dump
  212. 2120  '
  213. 2130  LOCATE 25,1:PRINT X$;:LOCATE 25,8:COLOR 15,2
  214. 2140  PRINT " Do you want (a)nother run, (w)ire lengths, or (q)uit?   (a/w/q) ";
  215. 2150  COLOR 7,0
  216. 2160  Z$=INKEY$:IF Z$=""THEN 2160
  217. 2170  IF Z$="a"THEN F=0:GOTO 1420
  218. 2180  IF Z$="w"THEN VK=1:GOTO 470
  219. 2190  IF Z$="q"THEN 140
  220. 2200  GOTO 2160
  221. 2210  END
  222. 2220  '
  223. 2230  '.....preface
  224. 2240  T=7
  225. 2250  PRINT TAB(T);
  226. 2260  PRINT "This program calculates values of the antenna shortening factor and"
  227. 2270  PRINT TAB(T);
  228. 2280  PRINT "and antenna lengths, including quarter-wave verticals over perfect"
  229. 2290  PRINT TAB(T);
  230. 2300  PRINT "ground, half-wavelength dipoles in free space, and long wire"
  231. 2310  PRINT TAB(T);
  232. 2320  PRINT "vertical and horizontal antennas. The frequency limits are 3 to 30"
  233. 2330  PRINT TAB(T);
  234. 2340  PRINT "MHz. All dimensions are calibrated to NEC-2 antenna models."
  235. 2350  PRINT
  236. 2360  PRINT TAB(T);
  237. 2370  PRINT "Programmed materials are AWG #18 (1.0mm) to AWG #10 (2.6mm) copper"
  238. 2380  PRINT TAB(T);
  239. 2390  PRINT "wire, and aluminum rod or tubing from 1.125";CHR$(34);" (3.2mm) to";
  240. 2400  PRINT " 2";CHR$(34);" (50.8mm)"
  241. 2410  PRINT TAB(T);
  242. 2420  PRINT "diameter."
  243. 2430  RETURN
  244. 2440  '
  245. 2450  'HARDCOPY
  246. 2460  GOSUB 2570:LOCATE 25,2:COLOR 14,6
  247. 2470  PRINT " Press 1 to print screen, 2 to print screen & ";
  248. 2480  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  249. 2490  Z$=INKEY$:IF Z$="3"THEN GOSUB 2570:RETURN
  250. 2500  IF Z$="1"OR Z$="2"THEN GOSUB 2570:GOTO 2520
  251. 2510  GOTO 2490
  252. 2520  FOR QX=1 TO 24:FOR QY=1 TO 80
  253. 2530  LPRINT CHR$(SCREEN(QX,QY));
  254. 2540  NEXT QY:NEXT QX
  255. 2550  IF Z$="2"THEN LPRINT CHR$(12)
  256. 2560  GOTO 2460
  257. 2570  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  258.